#lang racket


(require rosetta)

(provide backend-autocad-template
         render-with-floor
         render-with-floor-fn)


(define template-path (path->string (build-path (apps-dir) "autocad-render\\private\\template.dwt")))


(define (backend-autocad-template)
  (backend "autocad")
  (ac:close #f)
  (ac:open template-path))


(define (make-render-shape shape view-fn)
  (ac:layer "DarkGray")
  (evaluate shape))

(define (make-render-floor floor-width floor-height floor-color)
  (let ((floor-layer (case floor-color
                       ('white "FloorWhite")
                       ('black "FloorBlack")
                       (else (error 'make-floor (format "Floor color must be 'white or 'black, given ~A" floor-color)))))
        (z-min (reduce min (map bbox-min-z (map bbox (get-shapes))))))
    (ac:layer floor-layer)
    (evaluate (move-z z-min (surface (rectangle floor-width floor-height))))))

(define (render-shape-and-floor node view-fn width height path floor-width floor-height floor-color)
  (begin0
    (make-render-shape node view-fn)
    (let ((floor (make-render-floor floor-width floor-height floor-color)))
      (ac:com:set-sky-status-variable ac:com:sky-status-background-and-illumination)
      (view-fn)
      (render-shape width height path)
      (delete-shape floor)
      #f)))

(define (render-with-floor-impl node view-fn file dir ext width height floor-width floor-height floor-color)
  (let ((path (format "~A~A.~A" (path->string dir) file ext)))
    (displayln (format "Render (~Ax~A) ~A" width height path))
    (render-shape-and-floor node view-fn width height path floor-width floor-height floor-color)))

(define (render-with-floor #:dir (dir (render-dir))
                           #:ext (ext (render-ext))
                           #:width (width (render-width))
                           #:height (height (render-height))
                           #:floor-width (floor-width (render-floor-width))
                           #:floor-height (floor-height (render-floor-height))
                           #:floor-color (floor-color (render-floor-color))
                           . args)
  (match args
    ((list node file)
     (render-with-floor-impl node view file dir ext width height floor-width floor-height floor-color))
    ((list node file view-fn)
     (render-with-floor-impl node view-fn file dir ext width height floor-width floor-height floor-color))
    ((list node file center target)
     (render-with-floor-impl node (cλ view center target) file dir ext width height floor-width floor-height floor-color))
    ((list node file center target lens)
     (render-with-floor-impl node (cλ view center target lens) file dir ext width height floor-width floor-height floor-color))))

(define (render-with-floor-fn #:dir (dir (render-dir))
                              #:ext (ext (render-ext))
                              #:width (width (render-width))
                              #:height (height (render-height))
                              #:floor-width (floor-width (render-floor-width))
                              #:floor-height (floor-height (render-floor-height))
                              #:floor-color (floor-color (render-floor-color))
                              . args)
  (define (fn-name fn)
    (let* ((name (object-name fn))
           (file (symbol->string name)))
      (if name
          file
          (error 'render-with-floor-fn (format "render-with-floor-fn: first parameter (fn) must not be an anonymous function, given ~A; for anonymous functions use 'render-with-floor' instead" fn)))))
  (match args
    ((list fn)
     (render-with-floor-impl (fn) view (fn-name fn) dir ext width height floor-width floor-height floor-color))
    ((list fn view-fn)
     (render-with-floor-impl (fn) view-fn (fn-name fn) dir ext width height floor-width floor-height floor-color))
    ((list fn center target)
     (render-with-floor-impl (fn) (cλ view center target) (fn-name fn) dir ext width height floor-width floor-height floor-color))
    ((list fn center target lens)
     (render-with-floor-impl (fn) (cλ view center target lens) (fn-name fn) dir ext width height floor-width floor-height floor-color))))